home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MySort.p < prev    next >
Encoding:
Text File  |  1996-06-07  |  2.0 KB  |  103 lines  |  [TEXT/CWIE]
  1. unit MySort;
  2.  
  3. interface
  4.         
  5.     type
  6.         SortObject = object
  7.             procedure GetEntry( n: longint; dst_left: boolean ); { override and retrieve to left/right entry }
  8.             procedure SetEntry( n: longint; src_left: boolean ); { override and set from left/right entry }
  9.             function Compare: integer; { override and return -1, 0, 1 }
  10.             procedure Sort( count: longint );
  11.         end;
  12.  
  13. implementation
  14.  
  15.     procedure SortObject.GetEntry( n: longint; dst_left: boolean );
  16.     begin
  17. {$unused(n,dst_left)}
  18.     end;
  19.     
  20.     procedure SortObject.SetEntry( n: longint; src_left: boolean );
  21.     begin
  22. {$unused(n,src_left)}
  23.     end;
  24.     
  25.     function SortObject.Compare: integer;
  26.     begin
  27.         Compare := 0;
  28.     end;
  29.     
  30.     procedure SortObject.Sort( count: longint );
  31.         var
  32.             i, j: longint;
  33.     begin
  34.         for i := 2 to count do begin
  35.             GetEntry( i, true );
  36.             j := i - 1;
  37.             repeat
  38.                 GetEntry( j, false );
  39.                 if Compare < 0 then begin
  40.                     SetEntry( j + 1, false );
  41.                     j := j - 1;
  42.                 end else begin
  43.                     leave;
  44.                 end;
  45.             until j = 0;
  46.             SetEntry( j + 1, true );
  47.         end;
  48.     end;
  49.  
  50. end.
  51.  
  52.     type
  53.         MySortObject = object(SortObject)
  54.                 data: Str255;
  55.                 left, right: char;
  56.                 procedure GetEntry( n: longint; dst_left: boolean );
  57.                 override;
  58.                 procedure SetEntry( n: longint; src_left: boolean );
  59.                 override;
  60.                 function Compare: integer;
  61.                 override;
  62.             end;
  63.             
  64.     procedure MySortObject.GetEntry( n: longint; dst_left: boolean );
  65.     begin
  66.         if dst_left then begin
  67.             left := data[n];
  68.         end else begin
  69.             right := data[n];
  70.         end;
  71.     end;
  72.     
  73.     procedure MySortObject.SetEntry( n: longint; src_left: boolean );
  74.     begin
  75.         if src_left then begin
  76.             data[n] := left;
  77.         end else begin
  78.             data[n] := right;
  79.         end;
  80.     end;
  81.     
  82.     function MySortObject.Compare: integer;
  83.     begin
  84.         if left < right then begin
  85.             Compare := -1;
  86.         end else if left = right then begin
  87.             Compare := 0;
  88.         end else begin
  89.             Compare := 1;
  90.         end;
  91.     end;
  92.     
  93.     var
  94.         obj: MySortObject;
  95. begin
  96.     writeln('Hello');
  97.     new(obj);
  98.     obj.data := 'testing1234cba';
  99.     writeln( obj.data );
  100.     obj.Sort( length(obj.data) );
  101.     writeln( obj.data );
  102. end.
  103.